home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / sm.zip / SM.PAS < prev    next >
Pascal/Delphi Source File  |  1990-12-31  |  39KB  |  935 lines
  1. program Sm;
  2.    uses crt, dos, Graph, sounds;
  3. const
  4.    { The five fonts available }
  5.   Fonts : array[0..4] of string[13] =
  6.   ('DefaultFont', 'TriplexFont', 'SmallFont', 'SansSerifFont', 'GothicFont');
  7.  
  8.   { The five predefined line styles supported }
  9.   LineStyles : array[0..4] of string[9] =
  10.    ('SolidLn', 'DottedLn', 'CenterLn', 'DashedLn', 'UserBitLn');
  11.  
  12.   { The twelve predefined fill styles supported }
  13.   FillStyles : array[0..11] of string[14] =
  14.   ('EmptyFill', 'SolidFill', 'LineFill', 'LtSlashFill', 'SlashFill',
  15.    'BkSlashFill', 'LtBkSlashFill', 'HatchFill', 'XHatchFill',
  16.    'InterleaveFill', 'WideDotFill', 'CloseDotFill');
  17.  
  18.   { The two text directions available }
  19.   TextDirect : array[0..1] of string[8] = ('HorizDir', 'VertDir');
  20.  
  21.   { The Horizontal text justifications available }
  22.   HorizJust  : array[0..2] of string[10] = ('LeftText', 'CenterText', 'RightText');
  23.  
  24.   { The vertical text justifications available }
  25.   VertJust   : array[0..2] of string[10] = ('BottomText', 'CenterText', 'TopText');
  26.  
  27.  var
  28.   X,Y,Width,Height,OrigMode,LastCol,LastRow: Word;
  29.   Ch: Char;
  30.   Viewinfo : ViewPortType;
  31.   GraphDriver : integer;  { The Graphics device driver }
  32.   GraphMode   : integer;  { The Graphics mode value }
  33.   MaxX, MaxY  : word;     { The maximum resolution of the screen }
  34.   ErrorCode   : integer;  { Reports any graphics errors }
  35.   MaxColor    : word;     { The maximum color value available }
  36.   OldExitProc : Pointer;  { Saves exit procedure address }
  37. procedure LITTfont;        external;  {$L LITT.OBJ }
  38. procedure SANSfont;        external;  {$L SANS.OBJ }
  39. procedure TRIPfont;        external;  {$L TRIP.OBJ }
  40. procedure HercDriver;      external;  {$L HERC.OBJ }
  41. procedure EGAVGADriver;    external;  {$L EGAVGA.OBJ }
  42. procedure IBM8514Driver;    external;  {$L IBM8514.OBJ }
  43. procedure Loadthefont( ProcedurePointer : pointer );
  44.   begin
  45.     if RegisterBGIfont( ProcedurePointer ) < 0 then begin
  46.        writeln('Error registering font :', graphErrorMsg( Graphresult ) );
  47.        Halt( 1 );
  48.     end;
  49.   end;
  50. procedure PrepareTheFonts;
  51.   begin
  52.     Loadthefont( @LITTfont );
  53.     Loadthefont( @SANSfont );
  54.     Loadthefont( @TRIPfont );
  55.   end;
  56. procedure LoadtheDriver( ProcedurePointer : pointer );
  57.   begin
  58.     if RegisterBGIdriver( ProcedurePointer ) < 0 then begin
  59.        writeln('Error registering driver :', graphErrorMsg( Graphresult ) );
  60.        Halt( 1 );
  61.     end;
  62.   end;
  63. procedure PrepareTheDrivers;
  64.   begin
  65.     Loadthedriver( @EGAVGAdriver );
  66.     Loadthedriver( @HERCdriver );
  67.     Loadthedriver( @IBM8514driver );
  68.   end;
  69.  
  70. {$F+}
  71. procedure MyExitProc;
  72. begin
  73.   ExitProc := OldExitProc; { Restore exit procedure address }
  74.   CloseGraph;              { Shut down the graphics system }
  75. end; { MyExitProc }
  76. {$F-}
  77.  
  78. procedure Initialize;
  79. { Initialize graphics and report any errors that may occur }
  80. var
  81.   InGraphicsMode : boolean; { Flags initialization of graphics mode }
  82.   PathToDriver   : string;  { Stores the DOS path to *.BGI & *.CHR }
  83. begin
  84.    { when using Crt and graphics, turn off Crt's memory-mapped writes }
  85.   DirectVideo := False;
  86.   OldExitProc := ExitProc;                { save previous exit proc }
  87.   ExitProc := @MyExitProc;                { insert our exit proc in chain }
  88.   repeat
  89.  
  90. {$IFDEF Use8514}                          { check for Use8514 $DEFINE }
  91.     GraphDriver := IBM8514;
  92.     GraphMode := IBM8514Hi;
  93. {$ELSE}
  94.     GraphDriver := Detect;                { use autodetection }
  95. {$ENDIF}
  96.  
  97.     InitGraph(GraphDriver, GraphMode, '');
  98.     ErrorCode := GraphResult;             { preserve error return }
  99.     if ErrorCode <> grOK then             { error? }
  100.     begin
  101.       Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
  102.       if ErrorCode = grFileNotFound then  { Can't find driver file }
  103.       begin
  104.         Writeln('    !!!!!!!!!! Note !!!!!!!!!');
  105.         Writeln('   You must have EGA or VGA graphics card plus a color display.');
  106.         Writeln(' type <Ctrl-Break> to quit:');
  107.         Writeln;
  108.       end
  109.       else
  110.        Halt(1);                          { Some other error: terminate }
  111.     end;
  112.   until ErrorCode = grOK;
  113.   Randomize;                { init random number generator }
  114.   MaxColor := GetMaxColor;  { Get the maximum allowable drawing color }
  115.   MaxX := GetMaxX;          { Get screen resolution values }
  116.   MaxY := GetMaxY;
  117.  end; { Initialize }
  118.  
  119. function Int2Str(L : LongInt) : string;
  120. { Converts an integer to a string for use with OutText, OutTextXY }
  121. var
  122.   S : string;
  123. begin
  124.   Str(L, S);
  125.   Int2Str := S;
  126. end; { Int2Str }
  127.  
  128. function RandColor : word;
  129. { Returns a Random non-zero color value that is within the legal
  130.   color range for the selected device driver and graphics mode.
  131.   MaxColor is set to GetMaxColor by Initialize }
  132. begin
  133.   RandColor := Random(MaxColor)+1;
  134. end; { RandColor }
  135.  
  136. procedure DefaultColors;
  137. { Select the maximum color in the Palette for the drawing color }
  138. begin
  139.   SetColor(MaxColor);
  140. end; { DefaultColors }
  141.  
  142. procedure DrawBorder;
  143. { Draw a border around the current view port }
  144. var
  145.   ViewPort : ViewPortType;
  146. begin
  147.   DefaultColors;
  148.   SetLineStyle(SolidLn, 0, NormWidth);
  149.   GetViewSettings(ViewPort);
  150.   with ViewPort do
  151.     Rectangle(0, 0, x2-x1, y2-y1);
  152. end; { DrawBorder }
  153.  
  154. procedure FullPort;
  155. { Set the view port to the entire screen }
  156. begin
  157.   SetViewPort(0, 0, MaxX, MaxY, ClipOn);
  158. end; { FullPort }
  159.  
  160. procedure MainWindow(Header : string);
  161. { Make a default window and view port for demos }
  162. begin
  163.   DefaultColors;                           { Reset the colors }
  164.   ClearDevice;                             { Clear the screen }
  165.   SetTextStyle(DefaultFont, HorizDir, 1);  { Default text font }
  166.   SetTextJustify(CenterText, TopText);     { Left justify text }
  167.   FullPort;                                { Full screen view port }
  168.   OutTextXY(MaxX div 2, 2, Header);        { Draw the header }
  169.   { Draw main window }
  170.   SetViewPort(0, TextHeight('M')+4, MaxX, MaxY-(TextHeight('M')+4), ClipOn);
  171.   DrawBorder;                              { Put a border around it }
  172.   { Move the edges in 1 pixel on all sides so border isn't in the view port }
  173.   SetViewPort(1, TextHeight('M')+5, MaxX-1, MaxY-(TextHeight('M')+5), ClipOn);
  174. end; { MainWindow }
  175.  
  176. procedure StatusLine(Msg : string);
  177. { Display a status line at the bottom of the screen }
  178. begin
  179.   FullPort;
  180.   DefaultColors;
  181.   SetTextStyle(DefaultFont, HorizDir, 1);
  182.   SetTextJustify(CenterText, TopText);
  183.   SetLineStyle(SolidLn, 0, NormWidth);
  184.   SetFillStyle(EmptyFill, 0);
  185.   Bar(0, MaxY-(TextHeight('M')+4), MaxX, MaxY);      { Erase old status line }
  186.   Rectangle(0, MaxY-(TextHeight('M')+4), MaxX, MaxY);
  187.   OutTextXY(MaxX div 2, MaxY-(TextHeight('M')+2), Msg);
  188.   { Go back to the main window }
  189.   SetViewPort(1, TextHeight('M')+5, MaxX-1, MaxY-(TextHeight('M')+5), ClipOn);
  190. end; { StatusLine }
  191.  
  192. procedure color2;
  193. { give introduction }
  194.  
  195. var
  196.   ViewInfo : ViewPortType;
  197. begin
  198.   MainWindow('');
  199.   GetViewSettings(ViewInfo);
  200.   SetTextStyle(SmallFont, HorizDir,14);
  201.   SetTextJustify(LeftText, TopText);
  202.   with ViewInfo do
  203.     OutTextXY((x2-x1) div 8, (y2-y1) div 8, 'The');
  204.   SetTextStyle(TriplexFont, HorizDir, 4);
  205.   SetTextJustify(RightText, BottomText);
  206.   with ViewInfo do
  207.     OutTextXY((x2-x1)-50, (y2-y1)-50, 'Machine');
  208.   a:=0;
  209.   While a < Maxcolor+1 do
  210.     begin
  211.       SetColor(A);
  212.       SetTextStyle(SansSerifFont, HorizDir,10);
  213.       SetTextJustify(CenterText, CenterText);
  214.        with ViewInfo do
  215.          OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'Sound');
  216.       a:=a+1;
  217.       delay(100);
  218.     end;
  219.    s13;
  220.    a:=1;
  221.    While (a < MaxY) and (a < MaxX) do
  222.      begin
  223.        SetColor(RandColor);
  224.        SetLineStyle(SolidLn, 0, 1);
  225.        Circle((MaxX) div 2, (MaxY) div 2, a);
  226.        a:=a+10;
  227.      end;
  228.    s23;
  229.    a:=1;
  230.    While a < 190 do
  231.       begin
  232.         SetColor(0);
  233.         SetLineStyle(SolidLn, 0, 1);
  234.         Circle((MaxX) div 2, (MaxY) div 2, a);
  235.         a:=a+10;
  236.       end;
  237.    s7;
  238.    a:=0;
  239.    While a < 10 do
  240.     begin
  241.         SetBkColor(MaxColor);
  242.         delay(100);
  243.         SetBkcolor(0);
  244.         delay(100);
  245.         a:=a+1;
  246.     end;
  247.   RestoreCrtmode;
  248.   TextColor(black);
  249.   HighVideo;
  250.      TextBackground(cyan);
  251.      ClrScr;
  252.      WriteLn;
  253.      WriteLn;
  254.      WriteLn;
  255.      WriteLn('   The Sound Machine');
  256.      WriteLn;
  257.      WriteLn('                     was written by Daniel Bedinger');
  258.      WriteLn;     WriteLn('                         with special thanks to:');
  259.      WriteLn('                                                D. Ginskey');
  260.      WriteLn('                                                O. Wenger');
  261.      WriteLn('                                                R. Blue');
  262.      WriteLn('                                                Mr. Reames');
  263.      WriteLn;
  264.      TextColor(Magenta);
  265.      WriteLn('Dedicated to Alex, a true friend. The Best Summer ever! ');
  266.      WriteLn;
  267.      WriteLn;
  268.      LowVideo;
  269.      Textcolor(yellow);
  270.      WriteLn('--------------------------------------NOTE-------------------------------------');
  271.      WriteLn;
  272.      WriteLn('              You are encouraged to share this program with');
  273.      WriteLn('          friends on the conditions that the program is not');
  274.      WriteLn('          modified, and that no fee or consideration is charged.');
  275.      writeln;
  276.      textcolor(white);
  277.      writeln('                         Press <Enter> to continue.');
  278.   readln;
  279.   Textcolor(white);
  280.   TextBackground(black);
  281.   ClrScr;
  282.   writeln;
  283.   writeln;
  284.   writeln('   Do you have VGA? ');
  285.   Write(' <Y>es-<N>o] ');
  286.   Ch:=ReadKey;
  287.   If (ch = #121) or (ch = #89) then
  288.   begin
  289.    SetGraphMode(GetGraphMode);
  290.    MainWindow('THE SOUND MACHINE');
  291.    StatusLine('<Press any key for sound>      <Esc-exits>');
  292.    GetViewSettings(ViewInfo);    { draws speakers }
  293.      SetColor(yellow);
  294.      SetFillStyle(CloseDotFill, lightgray);
  295.      Bar3D(10, 10, MaxX div 2-100, Maxy-50, 0, TopOff);
  296.      Bar3D(MaxX-10, 10, MaxX div 2+100, Maxy-50, 0, TopOff);
  297.      Setcolor(lightBlue);
  298.      a:=90;
  299.      while a > 0 do
  300.        begin
  301.          Circle((MaxX div 2-100) div 2, MaxY  div 2, a);
  302.          Circle((MaxX div 2 +200) , MaxY div 2, a);
  303.          a:=a-10;
  304.        end;
  305.      Setcolor(Blue);
  306.      SetFillStyle(WideDotFill, lightgray);
  307.      FillEllipse(MaxX div 2+200, 100, 25, 35);
  308.      FillEllipse((MaxX div 2-100) div 2, 100, 25, 35);
  309.      Setcolor(lightgray);
  310.      SetFillStyle(solidFill, darkgray);
  311.      Bar3d(MaxX div 2-99,200,MaxX div 2+99, maxy-90, 0, TopOff);
  312.      SetLineStyle(solidln, 0, 3);
  313.      Line(MaxX div 2, 100, MaxX div 2, 200);
  314.      Line(MaxX div 2-50, 100, MaxX div 2+50, 100);
  315.      Line(MaxX div 2+40, 80, MaxX div 2-40, 120);
  316.      Line(MaxX div 2-40, 80, MaxX div 2+40, 120);
  317.      setLineStyle(solidln, 0, 1);
  318.      setcolor(lightcyan);
  319.      SetFillStyle(solidFill, black);
  320.      Bar3d(MaxX div 2-95,205,MaxX div 2+95, 225, 0, TopOff);
  321.      Setcolor(white);
  322.      GetViewSettings(Viewinfo);
  323.      SetTextStyle(smallFont, HorizDir, 6);
  324.      SetTextJustify(leftText, topText);
  325.      with ViewInfo do
  326.        OutTextXY(MaxX div 2-85,240, 'Main');
  327.        OutTextXY(MaxX div 2-85,260, 'Surround');
  328.        OutTextXY(MaxX div 2-85,280, 'Loudness');
  329.        OutTextXY(MaxX div 2-85,300, 'Graphics');
  330.        OutTextXY(MaxX div 2-85,320, 'Vol:');
  331.        OutTextXY(MaxX div 2-85,340, 'Bal:');
  332.        OutTextXY(MaxX div 2-85,360, 'Filter:');
  333.       Setcolor(lightred);
  334.        OutTextXY(MaxX div 2+40,240, '*');
  335.       Setcolor(red);
  336.        OutTextXY(MaxX div 2+40,260, '-');
  337.       Setcolor(red);
  338.        OutTextXY(MaxX div 2+40,280, '-');
  339.       Setcolor(lightred);
  340.        OutTextXY(MaxX div 2+40,300, '*');
  341.       Setcolor(cyan);
  342.        OutTextXY(MaxX div 2+30,320, 'Max');
  343.        OutTextXY(MaxX div 2+20,340, '50/50');
  344.        OutTextXY(MaxX div 2+30,360, 'Low');
  345.      StatusLine('<Press any key for sound>      <Esc-exits>');
  346.      Setcolor(yellow);
  347.      SetFillStyle(solidFill, yellow);
  348.      Bar3d(MaxX div 2-90,210,MaxX div 2-20, 220, 0, TopOff);
  349.      Setcolor(yellow);
  350.      SetFillStyle(solidFill, darkgray);
  351.      Bar3d(MaxX div 2-19,210,MaxX div 2+90, 220, 0, TopOff);
  352.   end  {end of vga speakers}
  353.   else
  354.    begin  {ega speakers}
  355.    SetGraphMode(GetGraphMode);
  356.    MainWindow('THE SOUND MACHINE');
  357.    StatusLine('<Press any key for sound>      <Esc-exits>');
  358.    GetViewSettings(ViewInfo);    { draws speakers }
  359.      SetColor(yellow);
  360.      SetFillStyle(CloseDotFill, lightgray);
  361.      Bar3D(10, 10, MaxX div 2-100, Maxy-50, 0, TopOff);
  362.      Bar3D(MaxX-10, 10, MaxX div 2+100, Maxy-50, 0, TopOff);
  363.      Setcolor(lightBlue);
  364.      a:=90;
  365.      while a > 0 do
  366.        begin
  367.          Circle((MaxX div 2-100) div 2, MaxY  div 2, a);
  368.          Circle((MaxX div 2 +200) , MaxY div 2, a);
  369.          a:=a-10;
  370.        end;
  371.      Setcolor(Blue);
  372.      SetFillStyle(WideDotFill, lightgray);
  373.      FillEllipse(MaxX div 2+200, 60, 25, 35);
  374.      FillEllipse((MaxX div 2-100) div 2, 60, 25, 35);
  375.      Setcolor(lightgray);
  376.      SetFillStyle(solidFill, darkgray);
  377.      Bar3d(MaxX div 2-99,100,MaxX div 2+99, maxy-80, 0, TopOff);
  378.      SetLineStyle(solidln, 0, 3);
  379.      Line(MaxX div 2, 30, MaxX div 2, 100);
  380.      Line(MaxX div 2-50, 30, MaxX div 2+50, 30);
  381.      Line(MaxX div 2+40, 10, MaxX div 2-40, 50);
  382.      Line(MaxX div 2-40, 10, MaxX div 2+40, 50);
  383.      setLineStyle(solidln, 0, 1);
  384.      setcolor(lightcyan);
  385.      SetFillStyle(solidFill, black);
  386.      Bar3d(MaxX div 2-95,105,MaxX div 2+95, 125, 0, TopOff);
  387.      Setcolor(white);
  388.      GetViewSettings(Viewinfo);
  389.      SetTextStyle(smallFont, HorizDir, 6);
  390.      SetTextJustify(leftText, topText);
  391.      with ViewInfo do
  392.        OutTextXY(MaxX div 2-85,130, 'Main');
  393.        OutTextXY(MaxX div 2-85,150, 'Surround');
  394.        OutTextXY(MaxX div 2-85,170, 'Loudness');
  395.        OutTextXY(MaxX div 2-85,190, 'Graphics');
  396.        OutTextXY(MaxX div 2-85,210, 'Vol:');
  397.        OutTextXY(MaxX div 2-85,230, 'Bal:');
  398.        OutTextXY(MaxX div 2-85,250, 'Filter:');
  399.       Setcolor(lightred);
  400.        OutTextXY(MaxX div 2+40,130, '*');
  401.       Setcolor(red);
  402.        OutTextXY(MaxX div 2+40,150, '-');
  403.       Setcolor(red);
  404.        OutTextXY(MaxX div 2+40,170, '-');
  405.       Setcolor(lightred);
  406.        OutTextXY(MaxX div 2+40,190, '*');
  407.       Setcolor(cyan);
  408.        OutTextXY(MaxX div 2+30,210, 'Max');
  409.        OutTextXY(MaxX div 2+20,230, '50/50');
  410.        OutTextXY(MaxX div 2+30,250, 'Low');
  411.      StatusLine('<Press any key for sound>      <Esc-exits>');
  412.      Setcolor(yellow);
  413.      SetFillStyle(solidFill, yellow);
  414.      Bar3d(MaxX div 2-90,110,MaxX div 2-20, 120, 0, TopOff);
  415.      Setcolor(yellow);
  416.      SetFillStyle(solidFill, darkgray);
  417.      Bar3d(MaxX div 2-19,110,MaxX div 2+90, 120, 0, TopOff);
  418.   end;
  419. end;  { Intro }
  420.  
  421. procedure SayGoodbye;
  422.   begin
  423.    MainWindow('');
  424.    GetViewSettings(ViewInfo);
  425.    A:=1;
  426.    While A<=8 do
  427.     begin
  428.      SetTextStyle(TriplexFont, HorizDir, a);
  429.      SetTextJustify(CenterText, CenterText);
  430.      Setcolor(15);
  431.       with ViewInfo do
  432.        OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'Bye Now!');
  433.      Setcolor(0);
  434.       with ViewInfo do
  435.        OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'Bye Now!');
  436.      a:=a+1
  437.     end;
  438.    Setcolor(15);
  439.     with ViewInfo do
  440.      OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'Bye Now!');
  441.    StatusLine('Press any key to quit...');
  442.    repeat until KeyPressed;
  443.  end; { SayGoodbye }
  444.  
  445. procedure Mono1;
  446.    begin
  447.      E:=True;
  448.      TextBackground(black);
  449.      ClrScr;
  450.      LowVideo;
  451.      TextColor(white);
  452.      WriteLn('     ══╦══  ║   ║  ╔═══ ');
  453.      WriteLn('       ║    ╠═══╣  ╠═   ');
  454.      WriteLn('       ║    ║   ║  ╚═══ ');
  455.      WriteLn;
  456.      WriteLn;
  457.      HighVideo;
  458.      TextColor(blink+white);
  459.      WriteLn('            ░░░░░     ░░░░░░    ░      ░   ░░      ░   ░░░     ');
  460.      WriteLn('           ▒▒   ▒▒   ░      ░   ░      ░   ░ ░     ░   ░░ ░░   ');
  461.      WriteLn('            ▓▓       ▒      ▒   ░      ░   ░  ░    ░   ░░  ░░  ');
  462.      WriteLn('             ▓▓      ▓      ▓   ▒      ▒   ░   ░   ░   ░░   ░░ ');
  463.      WriteLn('              ▓▓     ▓      ▓   ▓      ▓   ▒    ▒  ▒   ░░  ░░  ');
  464.      WriteLn('          ▓▓   ▓▓    ▓      ▓   ▓▓    ▓▓   ▓     ▓ ▓   ▒▒ ▒▒   ');
  465.      WriteLn('           ▓▓▓▓▓▓     ▓▓▓▓▓▓     ▓▓▓▓▓▓    ▓      ▓▓   ▓▓▓▓    ');
  466.      WriteLn;
  467.      WriteLn;
  468.      TextColor(white);
  469.      WriteLn('                    ▄     ▄     ▄      ▄▄▄▄▄▄▄           ▄▄▄▄▄▄▄         ▄▄▄▄▄  ');
  470.      WriteLn('                    ▌▌   ▐▐    ▐ ▌    ▐          ▐    ▌     █     ▌▌  ▌  ▌       ');
  471.      WriteLn('                    ▌ ▌ ▐ ▐   ▐   ▌   ▐          ▐▄▄▄▄▌     █     ▌ ▌ ▌  ██     ');
  472.      WriteLn('                    ▌  ▌▌ ▐  ▐ ▀▀▀ ▌  ▐          ▐    ▌     █     ▌  ▌▌  ▌       ');
  473.      WriteLn('                    ▌     ▐  ▐     ▌   ▀▀▀▀▀▀▀   ▐    ▌  ▀▀▀▀▀▀▀  ▌   ▌  ▀▀▀▀▀  ');
  474.      Delay(2000);s13;s23;s7;delay(4000);
  475.      HighVideo;
  476.      ClrScr;
  477.      WriteLn;
  478.      WriteLn;
  479.      WriteLn;
  480.      WriteLn('   The Sound Machine');
  481.      WriteLn;
  482.      WriteLn('                     was written by Daniel Bedinger');
  483.      WriteLn;
  484.      WriteLn('                         with special thanks to:');
  485.      WriteLn('                                                D. Ginskey');
  486.      WriteLn('                                                O. Wenger');
  487.      WriteLn('                                                R. Blue');
  488.      WriteLn('                                                Mr. Reames');
  489.      WriteLn;
  490.      NormVideo;
  491.      WriteLn('Dedicated to Alex, a true friend. The Best Summer ever! ');
  492.      WriteLn;
  493.      WriteLn;
  494.      LowVideo;
  495.      WriteLn('--------------------------------------NOTE-------------------------------------');
  496.      WriteLn;
  497.      WriteLn('              You are encouraged to share this program with');
  498.      WriteLn('          friends on the conditions that the program is not');
  499.      WriteLn('          modified, and that no fee or consideration is charged.');
  500.      repeat until KeyPressed;
  501.  
  502.      { Initialize the video mode, LastCol, LastRow, and the random number }
  503. { generator. Paint the help line. }
  504.   CheckBreak:=False;                   { turn off Contrl-C checking }
  505.   OrigMode:=LastMode;                  { Remember original video mode }
  506.   TextMode(Lo(LastMode));
  507.   LastCol:=Lo(WindMax)+1;              { get last column, row }
  508.   LastRow:=Hi(WindMax)+1;
  509.      TextColor(white);
  510.      TextBackground(black);
  511.      WriteLn('                               ╔═════════════════╗                             ');
  512.      WriteLn('                               ║THE SOUND MACHINE║                             ');
  513.      WriteLn('╔══════════════════════════════╩═════════════════╩════════════════════════════╗');
  514.      WriteLn('║ ░░░░░░░░░░░░░░░░░░░░░░░░░                         ░░░░░░░░░░░░░░░░░░░░░░░░░ ║');
  515.      WriteLn('║ ░░∙∙∙∙∙∙∙∙∙∙*∙∙∙∙∙∙∙∙∙∙░░       ┼┼┼┼┼┼┼┼┼         ░░∙∙∙∙∙∙∙∙∙∙*∙∙∙∙∙∙∙∙∙∙░░ ║');
  516.      WriteLn('║ ░░\∙∙∙∙∙∙∙*∙∙∙*∙∙∙∙∙∙∙/░░           │             ░░\∙∙∙∙∙∙∙*∙∙∙*∙∙∙∙∙∙∙/░░ ║');
  517.      WriteLn('║ ░░>>\····*·····*····/<<░░           │             ░░>>\∙∙∙∙*∙∙∙∙∙*∙∙∙∙/<<░░ ║');
  518.      WriteLn('║ ░░>>>>\·*·······*·/<<<<░░           │             ░░>>>>\·*·······*·/<<<<░░ ║');
  519.      WriteLn('║ ░░>>>>>>\·······/<<<<<<░░───────────┴─────────────░░>>>>>>\·······/<<<<<<░░ ║');
  520.      WriteLn('║ ░░>>>>>>>┌──┬──┐<<<<<<<░░»»                     ««░░>>>>>>>┌──┬──┐<<<<<<<░░ ║');
  521.      WriteLn('║ ░░>>>>>>>│  │  │<<<<<<<░░»»                     ««░░>>>>>>>│  │  │<<<<<<<░░ ║');
  522.      WriteLn('║ ░░>>>>>>>├──┼──┤<<<<<<<░░║║║║║║║║║║║║║║║║║║║║║║║║║░░>>>>>>>├──┼──┤<<<<<<<░░ ║');
  523.      WriteLn('║ ░░>>>>>>>│  │  │<<<<<<<░░             │           ░░>>>>>>>│  │  │<<<<<<<░░ ║');
  524.      WriteLn('║ ░░>>>>>>>└──┴──┘<<<<<<<░░ Main      ■ │ Vol:▓▓▓▓▓ ░░>>>>>>>└──┴──┘<<<<<<<░░ ║');
  525.      WriteLn('║ ░░>>>>/···········\<<<<░░             │           ░░>>>>/···········\<<<<░░ ║');
  526.      WriteLn('║ ░░>>/···············\<<░░ Surround  ∙ │ Bal:▓▓▓░░ ░░>>/···············\<<░░ ║');
  527.      WriteLn('║ ░░/···················\░░             ├───────────░░/···················\░░ ║');
  528.      WriteLn('║ ░░∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙░░ Loudness  ∙ │  Filters  ░░∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙░░ ║');
  529.      WriteLn('║ ░░∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙░░             │ Hi   ∙    ░░∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙░░ ║');
  530.      WriteLn('║ ░░∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙░░ Mono      ■ │ Lo   ■    ░░∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙░░ ║');
  531.      WriteLn('║ ░░░░░░░░░░░░░░░░░░░░░░░░░─────────────┴───────────░░░░░░░░░░░░░░░░░░░░░░░░░ ║');
  532.      WriteLn('╚═════════════════════════════════════════════════════════════════════════════╝');
  533.  
  534.   GoToXY(1,LastRow);                   { put message line on screen }
  535.   TextBackground(Black);
  536.   TextColor(White);
  537.   Write('           <Press any key for sound>     ',
  538.         '    <Esc-Exit>');
  539.   Dec(LastRow,80 div LastCol);         { don't write on message line }
  540.  
  541. { make typing window }
  542.   Width:=20;
  543.   Height:=0;
  544.   X:=30;
  545.   Y:=10;
  546.     TextBackground(white);
  547.     TextColor(black);
  548.     Window(X,Y,X+Width,Y+1);
  549.     wr;
  550. end;  {Mono1}
  551. procedure Color1;
  552.    begin
  553.      E:=True;
  554.      TextBackground(blue);
  555.      ClrScr;
  556.      LowVideo;
  557.      TextColor(white);
  558.      WriteLn('     ══╦══  ║   ║  ╔═══ ');
  559.      WriteLn('       ║    ╠═══╣  ╠═   ');
  560.      WriteLn('       ║    ║   ║  ╚═══ ');
  561.      WriteLn;
  562.      WriteLn;
  563.      HighVideo;
  564.      TextColor(blink+lightred);
  565.      WriteLn('            ░░░░░     ░░░░░░    ░      ░   ░░      ░   ░░░     ');
  566.      WriteLn('           ▒▒   ▒▒   ░      ░   ░      ░   ░ ░     ░   ░░ ░░   ');
  567.      WriteLn('            ▓▓       ▒      ▒   ░      ░   ░  ░    ░   ░░  ░░  ');
  568.      WriteLn('             ▓▓      ▓      ▓   ▒      ▒   ░   ░   ░   ░░   ░░ ');
  569.      WriteLn('              ▓▓     ▓      ▓   ▓      ▓   ▒    ▒  ▒   ░░  ░░  ');
  570.      WriteLn('          ▓▓   ▓▓    ▓      ▓   ▓▓    ▓▓   ▓     ▓ ▓   ▒▒ ▒▒   ');
  571.      WriteLn('           ▓▓▓▓▓▓     ▓▓▓▓▓▓     ▓▓▓▓▓▓    ▓      ▓▓   ▓▓▓▓    ');
  572.      WriteLn;
  573.      WriteLn;
  574.      TextColor(black);
  575.      WriteLn('                    ▄     ▄     ▄      ▄▄▄▄▄▄▄           ▄▄▄▄▄▄▄         ▄▄▄▄▄  ');
  576.      WriteLn('                    ▌▌   ▐▐    ▐ ▌    ▐          ▐    ▌     █     ▌▌  ▌  ▌       ');
  577.      WriteLn('                    ▌ ▌ ▐ ▐   ▐   ▌   ▐          ▐▄▄▄▄▌     █     ▌ ▌ ▌  ██     ');
  578.      WriteLn('                    ▌  ▌▌ ▐  ▐ ▀▀▀ ▌  ▐          ▐    ▌     █     ▌  ▌▌  ▌       ');
  579.      WriteLn('                    ▌     ▐  ▐     ▌   ▀▀▀▀▀▀▀   ▐    ▌  ▀▀▀▀▀▀▀  ▌   ▌  ▀▀▀▀▀  ');
  580.      Delay(2000);s13;s23;s7;delay(4000);
  581.      HighVideo;
  582.      TextBackground(cyan);
  583.      ClrScr;
  584.      WriteLn;
  585.      WriteLn;
  586.      WriteLn;
  587.      WriteLn('   The Sound Machine');
  588.      WriteLn;
  589.      WriteLn('                     was written by Daniel Bedinger');
  590.      WriteLn;
  591.      WriteLn('                         with special thanks to:');
  592.      WriteLn('                                                D. Ginskey');
  593.      WriteLn('                                                O. Wenger');
  594.      WriteLn('                                                R. Blue');
  595.      WriteLn('                                                Mr. Reames');
  596.      WriteLn;
  597.      TextColor(Magenta);
  598.      WriteLn('Dedicated to Alex, a true friend. The Best Summer ever! ');
  599.      WriteLn;
  600.      WriteLn;
  601.      LowVideo;
  602.      Textcolor(yellow);
  603.      WriteLn('--------------------------------------NOTE-------------------------------------');
  604.      WriteLn;
  605.      WriteLn('              You are encouraged to share this program with');
  606.      WriteLn('          friends on the conditions that the program is not');
  607.      WriteLn('          modified, and that no fee or consideration is charged.');
  608.      repeat until KeyPressed;
  609.  
  610.      { Initialize the video mode, LastCol, LastRow, and the random number }
  611. { generator. Paint the help line. }
  612.   CheckBreak:=False;                   { turn off Contrl-C checking }
  613.   OrigMode:=LastMode;                  { Remember original video mode }
  614.   TextMode(Lo(LastMode));
  615.   LastCol:=Lo(WindMax)+1;              { get last column, row }
  616.   LastRow:=Hi(WindMax)+1;
  617.      TextBackground(black);
  618.      TextColor(yellow);WriteLn('                               ╔═════════════════╗                             ');
  619.      Write('                               ║');
  620.      Textcolor(White);Write('THE SOUND MACHINE');
  621.      Textcolor(yellow);WriteLn('║                             ');
  622.      Textcolor(yellow);WriteLn('╔══════════════════════════════╩═════════════════╩════════════════════════════╗');
  623.      Write('║');textcolor(Brown);Write(' ░░░░░░░░░░░░░░░░░░░░░░░░░                         ░░░░░░░░░░░░░░░░░░░░░░░░░');
  624.      Textcolor(yellow);WriteLn(' ║');
  625.      Write('║');Textcolor(brown);Write(' ░░');
  626.      Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙');Textcolor(cyan);Write('*');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙');
  627.      TextColor(brown);Write('░░');Textcolor(lightgray);Write('       ┼┼┼┼┼┼┼┼┼         ');
  628.      Textcolor(brown);Write('░░');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙');Textcolor(cyan);Write('*');
  629.      Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙');Textcolor(brown);write('░░');Textcolor(yellow);Writeln(' ║');
  630.      Write('║');Textcolor(brown);write(' ░░');
  631.      Textcolor(white);Write('\∙∙∙∙∙∙∙');Textcolor(cyan);Write('*');Textcolor(white);Write('∙∙∙');Textcolor(cyan);Write('*');
  632.      Textcolor(white);Write('∙∙∙∙∙∙∙/');Textcolor(brown);Write('░░');Textcolor(lightgray);Write('           │             ');
  633.      Textcolor(brown);Write('░░');Textcolor(white);Write('\∙∙∙∙∙∙∙');Textcolor(cyan);Write('*');Textcolor(white);Write('∙∙∙');
  634.      Textcolor(cyan);Write('*');Textcolor(white);Write('∙∙∙∙∙∙∙/');Textcolor(brown);Write('░░');
  635.      Textcolor(yellow);Writeln(' ║');Write('║');Textcolor(brown);Write(' ░░');
  636.      Textcolor(darkgray);Write('>>');Textcolor(white);Write('\····*·····*····/');Textcolor(darkgray);Write('<<');
  637.      Textcolor(brown);Write('░░');Textcolor(lightgray);Write('           │             ');
  638.      Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>');Textcolor(white);Write('\∙∙∙∙*∙∙∙∙∙*∙∙∙∙/');
  639.      Textcolor(darkgray);Write('<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
  640.      Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>');
  641.      Textcolor(white);Write('\·*·······*·/');Textcolor(darkgray);Write('<<<<');
  642.      Textcolor(brown);Write('░░');Textcolor(lightgray);Write('           │             ');
  643.      Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>');Textcolor(white);Write('\·*·······*·/');
  644.      Textcolor(darkgray);Write('<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
  645.      Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>>>');
  646.      Textcolor(white);Write('\·······/');Textcolor(darkgray);Write('<<<<<<');
  647.      Textcolor(brown);Write('░░');Textcolor(lightgray);Write('───────────┴─────────────');
  648.      Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>>>');Textcolor(white);Write('\·······/');
  649.      Textcolor(darkgray);Write('<<<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
  650.      Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('┌──┬──┐');
  651.      Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(lightcyan);Write('»»                     ««');
  652.      Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('┌──┬──┐');
  653.      Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
  654.      Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('│  │  │');
  655.      Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(lightcyan);Write('»»                     ««');
  656.      Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('│  │  │');
  657.      Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
  658.      Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('├──┼──┤');
  659.      Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(lightgray);Write('║║║║║║║║║║║║║║║║║║║║║║║║║');
  660.      Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('├──┼──┤');
  661.      Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
  662.      Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('│  │  │');
  663.      Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(lightgray);Write('             │           ');
  664.      Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('│  │  │');
  665.      Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
  666.      Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('└──┴──┘');
  667.      Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(lightblue);Write(' Main      ');
  668.      Textcolor(lightred);Write('■');Textcolor(lightgray);Write(' │ ');Textcolor(lightblue);Write('Vol:');
  669.      Textcolor(green);Write('▓▓▓▓▓ ');
  670.      Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>>>>');Textcolor(lightgray);Write('└──┴──┘');
  671.      Textcolor(darkgray);Write('<<<<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
  672.      Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>>>');Textcolor(white);Write('/···········\');
  673.      Textcolor(darkgray);Write('<<<<');Textcolor(brown);Write('░░');Textcolor(lightgray);Write('             │           ');
  674.      Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>>>');Textcolor(white);Write('/···········\');
  675.      Textcolor(darkgray);Write('<<<<');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
  676.      Write('║');Textcolor(brown);Write(' ░░');Textcolor(darkgray);Write('>>');Textcolor(white);Write('/···············\');
  677.      Textcolor(darkgray);Write('<<');Textcolor(brown);Write('░░');Textcolor(lightblue);Write(' Surround  ');
  678.      Textcolor(red);Write('∙');Textcolor(lightgray);Write(' │ ');Textcolor(lightblue);Write('Bal:');
  679.      Textcolor(green);Write('▓▓▓▒▒ ');Textcolor(brown);Write('░░');Textcolor(darkgray);Write('>>');
  680.      Textcolor(white);Write('/···············\');Textcolor(darkgray);Write('<<');Textcolor(brown);Write('░░');
  681.      Textcolor(yellow);Writeln(' ║');
  682.      Write('║');Textcolor(brown);Write(' ░░');Textcolor(white);Write('/···················\');Textcolor(brown);Write('░░');
  683.      Textcolor(lightgray);Write('             ├───────────');Textcolor(brown);Write('░░');
  684.      Textcolor(white);Write('/···················\');Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
  685.      Write('║');Textcolor(brown);Write(' ░░');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙');Textcolor(brown);Write('░░');
  686.      Textcolor(lightblue);Write(' Loudness ');Textcolor(red);Write(' ∙');Textcolor(lightgray);Write(' │ ');
  687.      Textcolor(lightblue);Write(' Filters  ');Textcolor(brown);Write('░░');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙');
  688.      Textcolor(brown);Write('░░');Textcolor(yellow);Writeln(' ║');
  689.      Write('║');Textcolor(brown);Write(' ░░');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙');Textcolor(brown);Write('░░');
  690.      Textcolor(lightgray);Write('             │ ');Textcolor(lightblue);Write('Hi   ');Textcolor(red);Write('∙    ');
  691.      Textcolor(brown);Write('░░');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙');Textcolor(brown);Write('░░');
  692.      Textcolor(yellow);Writeln(' ║');
  693.      Write('║');Textcolor(brown);Write(' ░░');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙');Textcolor(brown);Write('░░');
  694.      Textcolor(lightblue);Write(' Color');Textcolor(lightred);Write('     ■');Textcolor(lightgray);Write(' │ ');
  695.      Textcolor(lightblue);Write('Low  ');Textcolor(lightred);Write('■    ');
  696.      Textcolor(brown);Write('░░');Textcolor(white);Write('∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙');Textcolor(brown);Write('░░');
  697.      Textcolor(yellow);Writeln(' ║');
  698.      Write('║');Textcolor(brown);Write(' ░░░░░░░░░░░░░░░░░░░░░░░░░');Textcolor(lightgray);Write('─────────────┴───────────');
  699.      Textcolor(brown);Write('░░░░░░░░░░░░░░░░░░░░░░░░░');Textcolor(yellow);Writeln(' ║');
  700.      WriteLn('╚═════════════════════════════════════════════════════════════════════════════╝');
  701.  
  702.   GoToXY(1,LastRow);                   { put message line on screen }
  703.   TextBackground(Black);
  704.   TextColor(White);
  705.   Write('           <Press any key for sound>     ',
  706.         '    <Esc-Exit>');
  707.   Dec(LastRow,80 div LastCol);         { don't write on message line }
  708.  
  709. { make typing window }
  710.   Width:=20;
  711.   Height:=0;
  712.   X:=30;
  713.   Y:=10;
  714.     TextBackground(white);
  715.     TextColor(black);
  716.     Window(X,Y,X+Width,Y+1);
  717.     wr;
  718. end;  {color1}
  719. procedure start;
  720.  var
  721.   z : boolean;
  722.  begin {start}
  723.   z:=False;
  724.   repeat
  725.     Ch:=ReadKey;
  726.     If E then write(ch);
  727.     case Ch of
  728.           #65, #97: s0; {A}
  729.           #66, #98: s1; {B}
  730.           #67, #99: s2; {C}
  731.           #68, #100: s3; {D}
  732.           #69, #101: s4; {E}
  733.           #70, #102: s5; {F}
  734.           #71, #103: s6; {G}
  735.           #72, #104: s7; {H}
  736.           #73, #105: s8; {I}
  737.           #74, #106: s9; {J}
  738.           #75, #107: s10; {K}
  739.           #76, #108: s11; {L}
  740.           #77, #109: s12; {M}
  741.           #78, #110: s13; {N}
  742.           #79, #111: s14; {O}
  743.           #80, #112: s15; {P}
  744.           #81, #113: s16; {Q}
  745.           #82, #114: s17; {R}
  746.           #83, #115: s18; {S}
  747.           #84, #116: s19; {T}
  748.           #85, #117: s20; {U}
  749.           #86, #118: S21; {V}
  750.           #87, #119: S22; {W}
  751.           #88, #120: S23; {X}
  752.           #89, #121: S24; {Y}
  753.           #90, #122: S25; {Z}
  754.           #48: s26; {0}
  755.           #49: Taps; {1}
  756.           #50: Sw; {2}
  757.           #51: Swars; {3}
  758.           #52: Yd; {4}
  759.           #53: Od; {5}
  760.           #54: Ld; {6}
  761.           #55: Jb; {7}
  762.           #56: Row; {8}
  763.           #57: March; {9}
  764.           #27: z:=True; { Esc }
  765.           #13:
  766.              begin
  767.               if E then wr; { Enter }
  768.              end;
  769.        else
  770.      begin
  771.       Sound(300); Delay(100); NoSound;
  772.       end;
  773.    end;
  774.    until z;
  775. end;
  776. procedure ck;
  777.  var
  778.   strng: string;
  779.   i : word;
  780.   x : integer;
  781.  begin
  782.     x:=1;
  783.     for i :=1 to paramcount do
  784.      begin
  785.       if copy(paramstr(i),1,1)='/' then
  786.        begin
  787.         strng :=paramstr(i);
  788.         for x:=1 to length(strng) do
  789.          begin
  790.           strng[x]:=upcase(strng[x]);
  791.           end;
  792.          if strng='/1' then
  793.            begin
  794.             start;
  795.             halt;
  796.            end;
  797.          if strng='/2' then
  798.           begin
  799.            ClrScr;
  800.            Write('A:\>');
  801.            start;
  802.            halt;
  803.           end;
  804.          if strng='/3' then
  805.            begin
  806.              Mono1;
  807.              start;
  808.              wr;
  809.              Write('  Good Bye ...');
  810.              Delay(2000);
  811.              TextBackground(black);
  812.              TextMode(LastMode);
  813.             halt;
  814.            end;
  815.          if strng='/4' then
  816.            begin
  817.              Color1;
  818.              start;
  819.              wr;
  820.              Write('  Good Bye ...');
  821.              Delay(2000);
  822.              TextBackground(black);
  823.              TextMode(LastMode);
  824.             halt;
  825.            end;
  826.          if strng='/5' then
  827.            begin
  828.              Initialize;
  829.              color2;
  830.              start;
  831.              SayGoodbye;
  832.              CloseGraph;
  833.             halt;
  834.            end;
  835.          end
  836.       end;
  837.  end;
  838. procedure note;
  839.    begin
  840.      ClrScr;
  841.      a:=1;
  842.      writeln('      Color Test   ');
  843.      for a:=1 to 15 do
  844.        begin                                                                          textcolor(a);
  845.         write('    ▓▒░█ ');
  846.         textcolor(a+blink);
  847.         writeln('     ▓▒░█ ');
  848.        end;
  849.      delay(1000);
  850.      ClrScr;
  851.      textcolor(white);
  852.      WriteLn;
  853.      WriteLn('        *** NOTE ***');
  854.      WriteLn('  A quick way to start The Sound Machine;');
  855.      WriteLn('         sm /1 = skips intro');
  856.      Writeln('         sm /2 = fake dos prompt');
  857.      WriteLn('         sm /3 = mono intro');
  858.      WriteLn('         sm /4 = color intro');
  859.      WriteLn('         sm /5 = color2 intro for EGA-VGA');
  860.      WriteLn('------------------------------------------------');
  861.      WriteLn;
  862.      WriteLn('  Press 1 to skip intro');
  863.      WriteLn('  Press 2 to display a fake dos prompt');
  864.      WriteLn('  Press 3 to start a Monocolor intro');
  865.      WriteLn('  Press 4 to start a Color intro');
  866.      WriteLn('  Press 5 to start a Graphics intro');
  867.      WriteLn('     This intro is only for EGA and VGA graphics.');
  868.      WriteLn('  Press Esc to exit');
  869.      writeln;
  870.      WriteLn('--------------------------------------NOTE-------------------------------------');
  871.      WriteLn('    The Sound Machine was written by Daniel Bedinger in Turbo Pascal.');
  872.      WriteLn('              You are encouraged to share this program with');
  873.      WriteLn('          friends on the conditions that the program is not');
  874.      WriteLn('          modified, and that no fee or consideration is charged.');
  875.    end;
  876.  
  877. begin  {main program}
  878.   PrepareTheFonts;
  879.   PrepareTheDrivers;
  880.   ck;
  881.   note;
  882.   repeat
  883.     Ch:=ReadKey;
  884.     case Ch of
  885.         #49: {1}
  886.           begin
  887.             ClrScr;
  888.             start;
  889.             E:=True;
  890.           end;
  891.         #50: {2}
  892.           begin
  893.             ClrScr;
  894.             Write('A:\>');
  895.             start;
  896.             ClrScr;
  897.             E:=True;
  898.           end;
  899.          #51: {3}
  900.            begin
  901.              Mono1;
  902.              start;
  903.              wr;
  904.              Write('  Good Bye ...');
  905.              Delay(2000);
  906.              TextBackground(black);
  907.              TextMode(LastMode);
  908.             end;
  909.           #52: {4}
  910.            begin
  911.              Color1;
  912.              start;
  913.              wr;
  914.              Write('  Good Bye ...');
  915.              Delay(2000);
  916.              TextBackground(black);
  917.              TextMode(LastMode);
  918.             end;
  919.           #53: {5}
  920.             begin
  921.              Initialize;
  922.              color2;
  923.              start;
  924.              SayGoodbye;
  925.              CloseGraph;
  926.              e:=true;
  927.             end;
  928.           #27: E:=True;  {esc}
  929.        else
  930.          begin
  931.            Sound(300); Delay(100); NoSound;
  932.          end;
  933.      end;
  934.    until E;
  935. end.